﻿#VisualFreeBasic_Form#  Version=5.6.2
Locked=0

[Form]
Name=Form1
ClassStyle=CS_VREDRAW,CS_HREDRAW,CS_DBLCLKS
ClassName=
WinStyle=WS_THICKFRAME,WS_CAPTION,WS_SYSMENU,WS_MINIMIZEBOX,WS_MAXIMIZEBOX,WS_CLIPSIBLINGS,WS_CLIPCHILDREN,WS_VISIBLE,WS_EX_WINDOWEDGE,WS_EX_CONTROLPARENT,WS_EX_LEFT,WS_EX_LTRREADING,WS_EX_RIGHTSCROLLBAR,WS_POPUP,WS_SIZEBOX
Style=3 - 常规窗口
Icon=
Caption=mCrtl控件例题
StartPosition=1 - 屏幕中心
WindowState=0 - 正常
Enabled=True
Repeat=False
Left=0
Top=0
Width=734
Height=555
TopMost=False
Child=False
MdiChild=False
TitleBar=True
SizeBox=True
SysMenu=True
MaximizeBox=True
MinimizeBox=True
Help=False
Hscroll=False
Vscroll=False
MinWidth=0
MinHeight=0
MaxWidth=0
MaxHeight=0
NoActivate=False
MousePass=False
TransPer=0
TransColor=SYS,25
Shadow=0 - 无阴影
BackColor=SYS,15
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[mCtrlTreeList]
Name=mCtrlTreeList1
Help=
Index=-1
Style=1 - 细边框
WindowTheme=True
ImageList=无图像列表控件
HasButton=True
HasLines=True
LinesRoot=True
GridLines=True
ShowSel=True
FullSel=True
NoHeight=False
DBuffer=True
ColHeader=True
HeaderDrop=True
SingleExpand=False
MultiSelect=False
NoTooltips=False
Enabled=True
Visible=True
Left=6
Top=38
Width=706
Height=333
Layout=5 - 宽度和高度
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[mCtrlChart]
Name=mCtrlChart1
Explain=
Help=
Index=-1
Style=0 - 饼形图
Frame=1 - 细边框
Caption=mCtrlChart1
Tips=True
DBuffer=True
Enabled=True
Visible=True
Left=7
Top=378
Width=196
Height=132
Layout=8 - 底部和宽度
Tag=
Tab=True

[mCtrlGrid]
Name=mCtrlGrid1
Explain=
Help=
Index=-1
Frame=1 - 细边框
OwnerData=False
TableCreate=True
Gridlines=True
DBuffer=True
ReLumns=True
ReRows=True
FocusGrid=True
EditLabels=True
Sel=3 - 任意单元格
ShowSel=True
Headern=2 - 字母列标题
RowHeadern=1 - 数字行标题
Enabled=True
Visible=True
Left=206
Top=378
Width=504
Height=132
Layout=8 - 底部和宽度
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[mCtrlMDItab]
Name=mCtrlMDItab1
Help=
Index=-1
Round=True
CloseButton=True
ListButton=1 - 滚动时显示
ScrollingBus=True
MiddleCclose=True
FocusOn=True
FocusNever=False
DBuffer=True
Animate=True
ExtendFrame=True
NoTooltips=False
DragDrop=True
DefWidth=0
MinWidth=100
Enabled=True
Visible=True
Left=0
Top=-1
Width=717
Height=32
Layout=1 - 调整宽度
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[ImageList]
Name=ImageList1
Index=-1
Image=folder.ico|ICON_FOLDERstring.ico|ICON_STRINGbinary.ico|ICON_BINARY
SizeW=16
SizeH=16
DPI=True
BackColor=SYS,15
Left=43
Top=582
Tag=


[AllCode]
'这是标准的工程模版，你也可做自己的模版。
'写好工程，复制全部文件到VFB软件文件夹里【template】里即可，子文件夹名为 VFB新建工程里显示的名称
'快去打造属于你自己的工程模版吧。

Sub Form1_Shown(hWndForm As hWnd, UserData As Integer)  '窗口完全显示后。UserData 来自显示窗口最后1个参数。
   

   mCtrlTreeList1.ImageList =  ImageList1.GethImageList 
   mCtrlTreeList1.AddColumn "Key/Value name",250 
   mCtrlTreeList1.AddColumn "Type",65 
   mCtrlTreeList1.AddColumn "Data", 180 
'   SendMessage(mCtrlTreeList1.hWnd , CCM_SETWINDOWTHEME, 0, Cast(LPARAM,@!"\u0045\u0078\u0070\u006C\u006F\u0072\u0065\u0072" ))    ' Explorer
   Dim keyName(4) As String = {"HKEY_CLASSES_ROOT", "HKEY_CURRENT_CONFIG", "HKEY_CURRENT_USER", "HKEY_LOCAL_MACHINE", "HKEY_USERS"}
   Dim keyVal(4) As HKEY  ={HKEY_CLASSES_ROOT,HKEY_CURRENT_CONFIG,HKEY_CURRENT_USER,HKEY_LOCAL_MACHINE,HKEY_USERS}
   For i As Long = 0 To UBound(keyVal)
       mCtrlTreeList1.AddItem(MC_TLI_ROOT,keyName(i),Cast(Integer,keyVal(i)),0,0,0,KeyHasChildren(keyVal(i))) 
   Next  
    
   mCtrlMDItab1.AddItem "注册表显示"
  mCtrlChart1.AddItem(10,"测试1") 
  mCtrlChart1.AddItem(30,"测试2") 
  mCtrlChart1.AddItem(50,"测试3") 
  mCtrlChart1.AddItem(80, "测试4") 
  
  mCtrlGrid1.ReSize(5,20) 

End Sub

Function KeyHasChildren(hKey As HKEY) As Long 
   Dim cSubkeys As ULong 
   Dim cValues As ULong 
   Dim s As Long = RegQueryInfoKey(hKey, NULL, NULL, NULL, @cSubkeys, NULL, NULL,@cValues, NULL, NULL, NULL, NULL)
   if s<> ERROR_SUCCESS Then Return  FALSE
   Function = cSubkeys > 0 Or  cValues > 0
End Function

Sub Form1_mCtrlTreeList1_NM_Click(hWndForm As hWnd, hWndControl As hWnd, NM As NMITEMACTIVATE)  '单击列表
    ' 详见微软文档 https://docs.microsoft.com/en-us/windows/win32/api/commctrl/ns-commctrl-nmitemactivate
    'NM.iItem    As Integer  被点击项目   仅在单击图标或第一列标签后才有效。要确定在行中其他位置单击时选择了哪个项目，请发送LVM_SUBITEMHITTEST消息。
    'NM.iSubItem As Integer  子项目
    'NM.ptAction As POINT    鼠标位置，相对与控件

End Sub

Function Form1_mCtrlTreeList1_MC_TLN_Expanding(hWndForm As hWnd, hWndControl As hWnd, NM As MC_NMTREELIST)As Long  '即将展开或折叠
'Sub Form1_mCtrlTreeList1_MC_TLN_Expanding(hWndForm As hWnd, hWndControl As hWnd, NM As MC_NMTREELIST)As Long   '即将展开或折叠
   '当父项即将展开或折叠时触发。                
   '成员hItemNew和lParamNew的MC_NMTREELIST指定正在改变其状态的项目。将该成员action设置为MC_TLE_EXPAND或MC_TLE_COLLAPSE，以分别指定该项目要展开还是折叠。
   '  NM.action     As UInteger   MC_TLE_EXPAND 或 MC_TLE_COLLAPSE  展开还是折叠
   '  NM.hItemNew   As MC_HTREELISTITEM  改变的句柄
   '  NM.lParamNew  As LPARAM            改变的数据
   if NM.action = MC_TLE_EXPAND Then 
       InsertChildren (NM.hItemNew, Cast(HKEY , NM.lParamNew ))
   ElseIf NM.action = MC_TLE_COLLAPSE Then 
      mCtrlTreeList1.Expand(NM.hItemNew,MC_TLE_COLLAPSE ,1)
   End if 
   Function = FALSE ' 应用程序可能会返回TRUE以防止项目状态更改，或FALSE以其他方式允许更改
  
End Function

Sub Form1_mCtrlTreeList1_MC_TLN_DeleteItem(hWndForm As hWnd, hWndControl As hWnd, NM As MC_NMTREELIST)  '删除项目
   '  NM.hItemOld   As MC_HTREELISTITEM  删除项目的句柄
   '  NM.lParamOld  As LPARAM            删除项目的数据
   Dim nKEY As HKEY = Cast(HKEY, NM.lParamOld)
   if nKEY then 
      Dim hParent As MC_HTREELISTITEM
      hParent = mCtrlTreeList1.GetNextItem(NM.hItemOld, MC_TLGN_PARENT)
      if hParent Then RegCloseKey(nKEY)
   End if 
End Sub

Sub InsertChildren(hItem As MC_HTREELISTITEM, nkey As HKEY)

   Dim dwIndex As DWORD
   Dim ss As LONG
   Dim dwBufferLen As DWORD
   Dim pszBuffer As WString * 262
   if nkey = 0 Then Return
   mCtrlTreeList1.ReDraw = False
   dwIndex = 0
   Do
      Dim hSubKey As HKEY
      dwBufferLen = 260
      ss = RegEnumKeyEx(nkey, dwIndex, pszBuffer, @dwBufferLen, NULL, NULL, NULL, NULL)
      dwIndex += 1
      if ss <> ERROR_SUCCESS Then Exit Do
      ss = RegOpenKeyEx(nkey, @pszBuffer, 0, KEY_READ, @hSubKey)
      if ss <> ERROR_SUCCESS Then Continue Do
      mCtrlTreeList1.AddItem(hItem, pszBuffer, Cast(Integer, hSubKey), 0, 0,0,KeyHasChildren(hSubKey))
   Loop
   dwIndex = 0
   Do
      Dim dwType As DWORD
      Dim ndata(512) As UByte
      Dim dwDataLen As DWORD = 512
      Dim hChildItem As MC_HTREELISTITEM
      ss = RegEnumValue(nkey, dwIndex, @pszBuffer, @dwBufferLen, NULL, @dwType, @ndata(0), @dwDataLen)
      dwIndex += 1
      if ss <> ERROR_SUCCESS Then
         if ss = ERROR_NO_MORE_ITEMS Then
            Exit Do
         Else
            continue Do
         End if
      End if
      Dim imgg As Long = IIf(dwType = REG_EXPAND_SZ Or dwType = REG_MULTI_SZ Or dwType = REG_SZ, 1, 2)
      if dwBufferLen > 0 Then 
         hChildItem = mCtrlTreeList1.AddItem(hItem, pszBuffer, 0, imgg, imgg, imgg)
      Else
          hChildItem = mCtrlTreeList1.AddItem(hItem,"<default>" , 0, imgg, imgg, imgg)
      End if 
      
      mCtrlTreeList1.SetItemText(hChildItem,1,ValueTypeName(dwType) )
      StringizeData(pszBuffer, 260, dwType, ndata(), dwDataLen)
      mCtrlTreeList1.SetItemText(hChildItem,2,pszBuffer)
   Loop
   mCtrlTreeList1.ReDraw = True
   mCtrlTreeList1.Refresh   
End Sub

Function ValueTypeName(dwType As DWORD) As String  
    Select Case dwType
        case REG_NONE:                 return "None"
        case REG_BINARY:               return "Binary"
        case REG_LINK:                 return "Link"
        case REG_DWORD:                return "Dword"
        case REG_DWORD_BIG_ENDIAN:     return "Dword (BE)"
        case REG_QWORD:                return "Qword"
        case REG_SZ:                   return "String"
        case REG_EXPAND_SZ:            return "String (expand)"
        case REG_MULTI_SZ:             return "String (multi)"
        Case Else :                    return "???"
    End Select 

End Function
Sub StringizeData(pszBuffer As WString ,  dwBufferLen as DWORD,  dwType As DWORD, ndata() As uByte ,dwDataLen As  DWORD )
   Select Case dwType
        case REG_NONE
            pszBuffer =""
        case REG_DWORD,REG_DWORD_BIG_ENDIAN
           Dim dw As DWORD = *CPtr(DWORD Ptr, @ndata(0))
           pszBuffer = wStr(dw)
        case REG_QWORD
           Dim dw As ULongInt  = *CPtr(ULongInt Ptr, @ndata(0))
           pszBuffer = wStr(dw)
        case REG_SZ,REG_LINK,REG_EXPAND_SZ,REG_MULTI_SZ
            pszBuffer = *CPtr(WString Ptr, @ndata(0))
        case Else
           if dwDataLen>80 Then dwDataLen =80
           pszBuffer = StringToCWSTR(ByteToChr(ndata(), dwDataLen) )
   End Select 
End Sub 

Sub Form1_mCtrlGrid1_NM_Click(hWndForm As hWnd, hWndControl As hWnd, NM As NMITEMACTIVATE)  '单击列表
    ' 详见微软文档 https://docs.microsoft.com/en-us/windows/win32/api/commctrl/ns-commctrl-nmitemactivate
    'NM.iItem    As Integer  被点击项目   仅在单击图标或第一列标签后才有效。要确定在行中其他位置单击时选择了哪个项目，请发送LVM_SUBITEMHITTEST消息。
    'NM.iSubItem As Integer  子项目
    'NM.ptAction As POINT    鼠标位置，相对与控件
   
End Sub

Function Form1_mCtrlGrid1_MC_GN_EndLabelEditW(hWndForm As hWnd, hWndControl As hWnd, NMG As MC_NMGDISPINFOW)As Long  '结束标签编辑 （Unicode字符）

   '  NMG.wColumn  As WORD  列
   '  NMG.wRow     As WORD  行
   '  NMG.cell.pszText     As WString Ptr   单元格文本
   '  NMG.cell.cchTextMax  As Integer       文本字符数
   '  NMG.cell.lParam      As LPARAM        用户数据
   '  NMG.cell.dwFlags     As DWORD         单元格标志 (对齐标记)
   mCtrlGrid1.SetCell(NMG.wColumn,NMG.wRow ,NMG.cell.pszText)
End Function





